
type Dim = Int
type Row = Int
type Col = Int
type Square = (Int,Int)
type Board = [Square]

-- Continuations

type Succ a = Board -> Fail a -> a
type Fail a = a

attacks :: Square -> Square -> Bool
attacks (x1, y1) (x2, y2) = 
  x1 == x2 || y1 == y2 || abs(x1 - x2) == abs(y1 - y2)

legal1 :: Square -> Board -> Bool
legal1 sq sqs = all (not . attacks sq) sqs

findCont :: Dim -> Board -> Row -> Col -> Succ a -> Fail a -> a
findCont _ b r 0 k k' = k b k' 
findCont _ _ 0 _ k k' = k'
findCont d b r c k k' = 
  let next = findCont d b (r-1) c k k' in
  if not $ legal1 (r,c) b then next else
  findCont d ((r,c):b) d (c-1) k next

findQueens :: Dim -> Maybe Board
findQueens d = findCont d [] d d (const . Just) Nothing

allQueens :: Dim -> [Board]
allQueens d = findCont d [] d d (:) []

-- -----------------------------------------------------------------------------
--  Continuations                                                               
-- -----------------------------------------------------------------------------

cons' :: a -> [a] -> ([a] -> k) -> k
cons' h t k = k(h : t)

map' :: (a -> b) -> [a] -> ([b] -> c) -> c
map' f [] k = k []
map' f (h:t) k = map' f t (\l -> cons' (f h) l k)

cmap' :: (a -> (b -> k) -> k) -> [a] -> ([b] -> k) -> k
cmap' f [] k = k []
cmap' f (h:t) k = cmap' f t (\bs -> f h (\b -> cons' b bs k))

filter' :: (a -> Bool) -> [a] -> ([a] -> c) -> c
filter' f [] k = k []
filter' f (h:t) k = filter' f t (\l -> if f h then k (h : l) else k l)

fact' :: Int -> (Int -> c) -> c 
fact' 0 k = k 1
fact' n k = fact' (n-1) (\f -> k (n * f))

append' :: [a] -> [a] -> ([a] -> c) -> c
append' [] l k = k l
append' (h:t) l k = append' t l (\m -> k (h:m))

concat' :: [[a]] -> ([a] -> c) -> c
concat' [] k = k []
concat' (h:t) k = concat' t (\l -> append' h l k)

fact 0 = 1
fact n = n * fact(n-1)

mapfact :: [Int] -> [Int]
mapfact = map fact

mapfact' :: [Int] -> ([Int] -> c) -> c
mapfact' = cmap' fact'

compose' :: (b -> (c -> k) -> k) 
         -> (a -> (b -> k) -> k) 
         -> a -> (c -> k) -> k
compose' f g a k = g a (\b -> f b k)

plus3 :: Int -> Int
plus3 = ((+) 1) . ((+) 2)

plus' :: Int -> Int -> (Int -> k) -> k
plus' n m k = k (n+m)

plus3' :: Int -> (Int -> k) -> k
plus3' = compose' (plus' 1) (plus' 2) 

lt :: Square -> Square -> Bool 
lt (x1, y1) (x2, y2) =
  x1 < x2 && y1 /= y2 && abs (x1 - x2) /= abs (y1 - y2)

prod :: [Int] -> [Int] -> [(Int,Int)]
prod l1 l2 = [(x, y) | x <- l1, y <- l2]

place' :: Int -> Board -> [Square] -> ([Board] -> c) -> c
place' n qs free k = 
  if length qs == n then k [qs] else
  cmap' (\sq k' -> place' n (sq:qs) (filter (lt sq) free) k') 
    free (\bs -> concat' bs k)

queens' :: Int -> ([Board] -> k) -> k
queens' n k = place' n [] (prod [0..n-1] [0..n-1]) k

queens :: Int -> [Board]
queens n = queens' n id


{- 
cmap' :: (a -> (b -> k) -> k) -> [a] -> ([b] -> k) -> k

(\f -> place n (f:qs) (filter (lt f) free)

place :: Int -> Board -> [Square] -> [Board]
place n qs free =
  if length qs == n then [qs] else
  concat (map (\f -> place n (f:qs) (filter (lt f) free)) free)

place' :: Int -> Board -> [Square] -> ([Board] -> k) -> k
place' n qs free k =
  if length qs == n then k [qs] else


lt' :: Square -> Square -> (Bool -> k) -> k
lt' a b k = k(lt a b)

  -} 


{- 

  concat' 


-- -----------------------------------------------------------------------------
--  Roland                                                                      
-- -----------------------------------------------------------------------------

lt :: Square -> Square -> Bool
lt (x1, y1) (x2, y2) =
  x1 < x2 && y1 /= y2 && abs (x1 - x2) /= abs (y1 - y2)

prod :: [Int] -> [Int] -> [(Int,Int)]
prod l1 l2  = [(x, y) | x <- l1, y <- l2]

place :: Int -> Board -> [Square] -> [Board]
place n qs free =
  if length qs == n then [qs] else
  concat (map (\f -> place n (f:qs) (filter (lt f) free)) free)

queens :: Int -> [Board]
queens n = place n [] (prod [0..n-1] [0..n-1])

-} 
